home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / Scroll-Shan.st < prev    next >
Text File  |  1993-07-24  |  9KB  |  313 lines
  1. SemanticObject subclass: #RoamBox
  2.     instanceVariableNames: 'marker updateStyle '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'Scroll-Shan'!
  6.  
  7.  
  8. !RoamBox methodsFor: 'private'!
  9.  
  10. extent: ext clientMode: aMode 
  11.     "Shan September 11, 1989"
  12.  
  13.     aMode semanticObject notNil
  14.         ifTrue: ["Use semanticObject as a connection point is the standard 
  15.             way. "
  16.             target1 _ aMode semanticObject]
  17.         ifFalse: [target1 _ aMode].
  18.     mode extent: ext.
  19.     self checkMarkerSizeAndPosition.
  20.     self clientMode addDependent: self! !
  21.  
  22. !RoamBox methodsFor: 'MMS-initializations'!
  23.  
  24. setUpAppearance
  25.     "Shan June 20, 1989"
  26.  
  27.     | dispObj |
  28.     super setUpAppearance.  "Shan July 21, 1989"
  29.     dispObj _ mode displayObject.
  30.     dispObj borderWidth: 2.
  31.     dispObj insideColor: Form white!
  32.  
  33. setUpController
  34.     "Shan June 23, 1989"
  35.  
  36.     | ctrl erDict |
  37.     ctrl _ OpaqueController1 new.
  38.     erDict _ ctrl eventResponses deepCopy.
  39.     erDict at: #enterMode put: #refresh:.
  40.     ctrl eventResponses: erDict.
  41.     mode controller: ctrl! !
  42.  
  43. !RoamBox methodsFor: 'initialize-release'!
  44.  
  45. initialize
  46.     "Shan July 12, 1989"
  47.     super initialize.
  48.     updateStyle _ #discrete.
  49.     "Shan September 11, 1989"
  50.     marker _ Marker new.
  51.     marker attachModeTo: mode at: 5@5 extent: 40@30.!
  52.  
  53. release
  54.     self clientMode removeDependent: self.
  55.     super release! !
  56.  
  57. !RoamBox methodsFor: 'scrolling'!
  58.  
  59. checkMarkerSizeAndPosition
  60.     "This will set the marker size to reflect the ratio between the client   
  61.     mode window and the client mode roaming region.  Shan June 23, 1989"
  62.  
  63.     | ratio mOrg mExt cBoundBox clientM cWindow insetExt |
  64.     insetExt _ mode window extent - (mode borderWidth * 2).
  65.     clientM _ self clientMode.
  66.     "For mode composer.  Shan September 11, 1989"
  67.     clientM isNil
  68.         ifTrue: [mExt _ marker mode extent. mOrg _ marker mode origin]
  69.         ifFalse: 
  70.             ["insetExt _ mode insetDisplayBox extent."
  71.             cBoundBox _ clientM contentsBoundingBox.
  72.             cWindow _ clientM window.
  73.             ratio _ insetExt / cBoundBox extent.
  74.             mOrg _ (cWindow origin - cBoundBox origin * ratio) rounded.
  75.             "Adjust the position"
  76.             mOrg _ mOrg + mode borderWidth.
  77.             mExt _ (cWindow extent * ratio) rounded].
  78.     "Make it fit into the movable area."
  79.     mExt _ mExt min: insetExt.
  80.     "See if self is a roamBox or scroll bar."
  81.     mode displayBox width / mode displayBox height > 3
  82.         ifTrue: 
  83.             ["horizontal scrollbar"
  84.             mExt _ mExt y: insetExt y.
  85.             mOrg y: mode borderWidth]
  86.         ifFalse: [mode displayBox height / mode displayBox width > 3
  87.                 ifTrue: 
  88.                     ["vertical scrollbar"
  89.                     mExt _ mExt x: insetExt x.
  90.                     mOrg x: mode borderWidth]].
  91.     (mOrg extent: mExt)
  92.         = marker mode viewport
  93.         ifTrue: ["No change"
  94.             ^false]
  95.         ifFalse: 
  96.             [marker mode origin: mOrg extent: mExt.
  97.             ^true]!
  98.  
  99. markerMovedTo: aRect 
  100.     "The marker has moved.  Scroll the client accordingly.  The scroll bar   
  101.      is implemented as it is for roaming and then spefialized for horizontal 
  102.       
  103.      and vertical scroll.  Shan June 23, 1989"
  104.  
  105.     | insetDispB ratio clientM clientW cBoundBox newOrg |
  106.     clientM _ self clientMode.
  107.     "For mode composer.  Shan September 11, 1989"
  108.     clientM isNil ifTrue: [^self].
  109.     insetDispB _ mode insetDisplayBox.
  110.     clientW _ clientM window.
  111.     cBoundBox _ clientM contentsBoundingBox.
  112.     "Compute the ratio to scroll"
  113.     ratio _ aRect origin - insetDispB origin / insetDispB extent.
  114.     newOrg _ (cBoundBox extent * ratio) rounded + cBoundBox origin.
  115.     "The size of the client window is not going to change when scrolling."
  116.     "See if self is a roamBox or scroll bar."
  117.     mode displayBox width / mode displayBox height > 3
  118.         ifTrue: ["horizontal scrollbar"
  119.             newOrg y: clientW top]
  120.         ifFalse: [mode displayBox height / mode displayBox width > 3 ifTrue: ["vertical scrollbar"
  121.                 newOrg x: clientW left]].
  122.     clientW _ clientW moveTo: newOrg.
  123.     "Check to see whether the window is moved or not.  Shan July 12, 
  124.     1989 "
  125.     clientW = clientM window ifTrue: [^self].
  126.     clientM window: clientW viewport: clientM viewport.
  127.     clientM computeSubLayering.
  128.     updateStyle == #discrete ifTrue: [Cursor wait show].
  129.     clientM insideColor isNil ifTrue: [clientM erase].
  130.     clientM display.
  131.     updateStyle == #discrete ifTrue: [Cursor normal show]! !
  132.  
  133. !RoamBox methodsFor: 'controller-msg'!
  134.  
  135. processCursorMove: e 
  136.     "This is to update the scrolled mode continuously.  Shan July 12,  
  137.     1989"
  138.  
  139.     updateStyle ~~ #continuous ifTrue: [^self].
  140.     "The offset between the origin of the rubber frame and the cursorPt 
  141.     is stored in e data offset.  Shan July 16, 1989"
  142.     self markerMovedTo: (e origin - e data offset extent: marker mode displayBox extent)!
  143.  
  144. refresh: e 
  145.     "Update the size and position of the marker when the cursor first  
  146.     enters the scroll bar.  Shan June 23, 1989"
  147.  
  148.     self checkMarkerSizeAndPosition ifTrue: [mode display]! !
  149.  
  150. !RoamBox methodsFor: 'access'!
  151.  
  152. clientMode
  153.     "Shan September 11, 1989"
  154.  
  155.     target1 isNil
  156.         ifTrue: [^nil]
  157.         ifFalse: ["target1 has to be either Mode or SemanticObject."
  158.             (target1 isKindOf: Mode)
  159.                 ifTrue: [^target1]
  160.                 ifFalse: [^target1 mode]]!
  161.  
  162. updateStyle: aSymbol 
  163.     "aSymbol can be either #discrete or #continuous.  Shan July 12, 
  164.     1989 "
  165.  
  166.     updateStyle _ aSymbol! !
  167.  
  168. !RoamBox methodsFor: 'updating'!
  169.  
  170. update: x 
  171.     "This is sent when the marker size and position is possibly out of date. 
  172.      The occations are: client adds/removes subModes, subModes of the  
  173.     client moves. Shan June 23, 1989"
  174.  
  175.     x = #contentsBoundingBoxMayBeChanged ifTrue: [self checkMarkerSizeAndPosition ifTrue: [mode display]]! !
  176.  
  177. !RoamBox methodsFor: 'drag support'!
  178.  
  179. dragControllerFor: aSymbol
  180.     "Return a Controller that is sensitive to cursorMove Event.  It is use to continuously update the scrolled mode. Shan July 11, 1989"
  181.  
  182.     | ctrl erDict |
  183.     ctrl _ OpaqueController1 new.
  184.     erDict _ ctrl eventResponses deepCopy.
  185.     erDict at: #cursorMove put: #processCursorMove:.
  186.     ctrl eventResponses: erDict.
  187.     ^ctrl! !
  188. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  189.  
  190. RoamBox class
  191.     instanceVariableNames: ''!
  192.  
  193.  
  194. !RoamBox class methodsFor: 'instance creation'!
  195.  
  196. extent: ext clientMode: aMode 
  197.     "The client must be a mode.  Shan September 11, 1989"
  198.  
  199.     ^self new extent: ext clientMode: aMode! !
  200.  
  201. !RoamBox class methodsFor: 'memory management'!
  202.  
  203. private
  204.     "Shan June 23, 1989"
  205.  
  206.     "RoamBox allInstances do: [: each | each nilFields]"! !
  207.  
  208. !RoamBox class methodsFor: 'testing'!
  209.  
  210. bkScrollTest
  211.     "(RootMode new addSubMode: self bkScrollTest) startUp" 
  212.     "This is to test the scrolling ability of a picture.  The picture is first 
  213.     draw on a subMode, and then the subMode is scrolled. Shan June 24, 
  214.     1989 "
  215.     "mode displayObject relAdd: (self clientMode firstSubMode imageSize: 196 @ 100 window: (0@0 extent:1000@250))."
  216.  
  217.     | rMode sMode sSMode sBar dispObj spline line rand |
  218.     rMode _ Mode new borderWidth: 0.
  219.     rMode displayObject absAdd: (Quadrangle region: (49@49 extent: 302@202) borderWidth: 1 borderColor: Form black insideColor: Form white).
  220.     sMode _ Simple origin: 50 @ 50 extent: 300 @ 200.
  221.     sSMode _ Simple origin: 0 @ 0 extent: 1000 @ 250.
  222.     dispObj _ sSMode displayObject.
  223.     dispObj boundingBox: (0@0 extent: 1000@250).
  224.     spline _ MMSSpline new.
  225.     spline form: (Form new extent: 3 @ 3) black.
  226.     rand _ Random new.
  227.     0 to: 25 do: [:n | spline add: 40 * n @ (rand next * 250) rounded].
  228.     dispObj absAdd: spline.
  229.     line _ MMSLine
  230.                 from: 0 @ 125
  231.                 to: 1000 @ 125
  232.                 width: 4
  233.                 color: Form darkGray.
  234.     dispObj absAdd: line.
  235.     dispObj insideColor: Form white. "This is necessary to make spline work."
  236.     sMode insideColor: Form white. "To avoid eraseing the bk"
  237.     sSMode borderWidth: 0.
  238.     sMode borderWidth: 0.
  239.     dispObj makeAbsoluteFaster.
  240.     rMode addSubMode: sMode.
  241.     sMode addSubMode: sSMode.
  242.     sBar _ RoamBox extent: 200 @ 18 clientMode: sMode.
  243.     sBar attachModeTo: rMode at: 50 @ 260.
  244.     sBar updateStyle: #continuous.
  245.     "Make reference points for roam demo."
  246.     rMode displayObject absAdd: (MMSLine from: 50@260 to: 50@260).
  247.     rMode displayObject absAdd: (MMSLine from: 250@360 to: 250@360).
  248.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  249.  
  250. scrollTest
  251.     "self scrollTest"
  252.  
  253.     | rMode sMode s1SMode sSMode sBar dispObj line |
  254.     rMode _ RootMode new.
  255.     sMode _ Simple origin: 50 @ 50 extent: 200 @ 200.
  256.     dispObj _ sMode displayObject.
  257.     line _ MMSLine
  258.                 from: 0 @ 0
  259.                 to: 500 @ 50
  260.                 width: 2 @ 2
  261.                 color: Form black.
  262.     dispObj relAdd: line.
  263.     sSMode _ Simple origin: 20 @ 20 extent: 100 @ 400.
  264.     sSMode insideColor: Form lightGray.
  265.     s1SMode _ Simple origin: 25 @ 120 extent: 400 @ 50.
  266.     s1SMode insideColor: Form gray.
  267.     rMode addSubMode: sMode.
  268.     sMode addSubMode: sSMode.
  269.     sMode addSubMode: s1SMode.
  270.     sBar _ RoamBox extent: 18@200 clientMode: sMode.
  271.     sBar attachModeTo: rMode at: 260@50.
  272.     sBar _ RoamBox extent: 200@18 clientMode: sMode.
  273.     sBar attachModeTo: rMode at: 50@260.
  274.     rMode startUp! !
  275.  
  276. SemanticObject subclass: #Marker
  277.     instanceVariableNames: ''
  278.     classVariableNames: ''
  279.     poolDictionaries: ''
  280.     category: 'Scroll-Shan'!
  281.  
  282.  
  283. !Marker methodsFor: 'controller-msg'!
  284.  
  285. moveMarker: e 
  286.     "Tracking the marker and communicate with the client.  Shan June 20, 
  287.      1989"
  288.  
  289.     | oldDispB |
  290.     oldDispB _ mode displayBox.
  291.     mode controller moveFrameConstrained.
  292.     oldDispB ~= mode displayBox ifTrue: ["Maybe I should use a link instead."
  293.         mode superMode semanticObject markerMovedTo: mode displayBox]! !
  294.  
  295. !Marker methodsFor: 'MMS-initializations'!
  296.  
  297. setUpAppearance
  298.     "Shan June 20, 1989"
  299.  
  300.     | dispObj |
  301.     super setUpAppearance.
  302.     dispObj _ mode displayObject.
  303.     dispObj insideColor: Form gray!
  304.  
  305. setUpController
  306.     "Shan June 20, 1989"
  307.  
  308.     | ctrl erDict |
  309.     ctrl _ OpaqueController1 new.
  310.     erDict _ ctrl eventResponses deepCopy.
  311.     erDict at: #leftButtonDown put: #moveMarker:.
  312.     ctrl eventResponses: erDict.
  313.     mode controller: ctrl! !